      subroutine parlocat_all 
!-----------------------------------------------
!   M o d u l e s 
!-----------------------------------------------
      USE vast_kind_param, ONLY:  double 
      use corgan_com_M 
      use cindex_com_M 
      use numpar_com_M 
      use cprplt_com_M, ONLY:  
      use cophys_com_M 
      use ctemp_com_M, ONLY: fmf, fef, fvf, fbxf, fbyf, fbzf, twx 
      use blcom_com_M, ONLY: t_wall, iplost, plost_pos, plost_neg, iphd2, &
         wate, divpix, bxv, byv, bzv, x, y, z, area_x, area_y, area_z, tsix, &
         tsiy, tsiz, iphead, ijkcell, ijktmp2, ijktmp3, ijktmp4, ijkctmp, nux, &
         nuy, nuz, etax, etay, etaz, px, py, pz, pxi, peta, pzta, up, vp, wp, &
         link, ico, qpar, xptilde, yptilde, zptilde, uptilde, vptilde, &
         wptilde, vrms, killer, bcpl, bcpr, bcpt, bcpb, bcpe, bcpf, xl, xr, &
         yt, yb, ze, zf 
      use objects_com_M, ONLY:  
!...Translated by Pacific-Sierra Research 77to90  4.3E  14:13:36   8/20/02  
!...Switches: -yf -x1             
!
      implicit none
!-----------------------------------------------
!   G l o b a l   P a r a m e t e r s
!-----------------------------------------------
!-----------------------------------------------
!   L o c a l   P a r a m e t e r s
!-----------------------------------------------
!-----------------------------------------------
!   L o c a l   V a r i a b l e s
!-----------------------------------------------
      integer :: j1 
      integer , dimension(8) :: iv 
      integer , dimension(4) :: lioinput, lioprint 
      integer :: n, np, inew, jnew, knew, ijknew 
      real(double), dimension(1) :: ixi1, ixi2, ieta1, ieta2 
      real(double) :: ixi4, ieta4, ixi5, ieta5 
      real(double), dimension(8) :: wght 
      real(double), dimension(100) :: fpxf, fpyf, fpzf, fpxft, fpyft, fpzft, &
         ucm, vcm, wcm, cm 
      real(double), dimension(3,20) :: wsin, wcos 
      real(double), dimension(3,12,20) :: tsi, rot 
      real(double) :: nuxp, nuyp, nuzp, nu, dtdummy 
      logical :: expnd, nomore, succes 
      character :: name*80 
!-----------------------------------------------
!
!
!
!     *******************************************
!
!     relocates the particles on the grid
!     after a call to meshgen
!
!     *********************************************
!
!dir$ ivdep
!
      iphd2(ijkcell(:ncells)) = 0 
      iphd2(1) = iphead(1) 
!
!
    1 continue 
      nomore = .TRUE. 
!
!     check for more particles to process
!
      ncellsp = 0 
      do n = 1, ncells 
         if (iphead(ijkcell(n)) <= 0) cycle  
         ijk = ijkcell(n) 
         np = iphead(ijk) 
!
         ncellsp = ncellsp + 1 
         ijkctmp(ncellsp) = ijkcell(n) 
         ijktmp2(ncellsp) = ijkcell(n) 
!
      end do 
!
!     if there are more, process particles as though there were one
!     in every cell in the mesh
!
      if (ncellsp /= 0) then 
!
         nomore = .FALSE. 
!
!
!
!     ******************************************************************
!
!     calculate new natural coordinates of mid-point
!
!     ******************************************************************
         dtdummy = 0.0 
!
         call parlocat (ncellsp, ijkctmp, iphead, iwid, jwid, kwid, nsampl, &
            vrms, t_wall, ico, ijktmp2, ijktmp3, ijktmp4, rmaj, dz, divpix, &
            area_x, area_y, area_z, dtdummy, itdim, npart, ibar, jbar, kbar, &
            mgeom, cdlt, sdlt, plost_pos, plost_neg, wate, x, y, z, bxv, byv, &
            bzv, xptilde, yptilde, zptilde, uptilde, vptilde, wptilde, tsix, &
            tsiy, tsiz, etax, etay, etaz, nux, nuy, nuz, link, iplost, qpar, px&
            , py, pz, up, vp, wp, pxi, peta, pzta, cartesian, killer, bcpl, &
            bcpr, bcpb, bcpt, bcpe, bcpf, dx, dy, dz, xl, xr, yb, yt, ze, zf, &
            nu_len, nu_comm) 
 
!
!
!
!
!
         do n = 1, ncellsp 
            ijk = ijkctmp(n) 
            np = iphead(ijk) 
            if (np <= 0) cycle  
!
            inew = int(pxi(np)) 
            jnew = int(peta(np)) 
            knew = int(pzta(np)) 
!
            if ((inew - 2)*(ibp1 - inew) < 0) write (*, *) 'np=', np, 'inew=', &
               inew 
            if ((jnew - 2)*(jbp1 - jnew) < 0) write (*, *) 'np=', np, 'jnew=', &
               jnew 
            if ((knew - 2)*(kbp1 - knew) < 0) write (*, *) 'np=', np, 'knew=', &
               knew 
            ijknew = (knew - 1)*kwid + (jnew - 1)*jwid + (inew - 1)*iwid + 1 
            if (killer(n) /= 0) ijknew = 1 
!
            iphead(ijk) = link(np) 
            link(np) = iphd2(ijknew) 
            iphd2(ijknew) = np 
!
         end do 
!
!     ********************************************************
!
!     a routine to locate a particle on a grid
!     ************************************************************************
!
!     all particles have been processed
!
!     ***********************************************************************
 
         if (.not.nomore) go to 1 
!
      endif 
!
      do n = 1, ncells 
         ijk = ijkcell(n) 
         iphead(ijk) = iphd2(ijk) 
         iphd2(ijk) = 0 
      end do 
      iphead(1) = iphd2(1) 
!
!
 
!
      return  
!l    ------------------------------------------> return ----->>>
!
      end subroutine parlocat_all 
